home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pcalc.arc / PCALC.C
Text File  |  1985-07-26  |  43KB  |  2,177 lines
  1. /*
  2.  * This programmable integer arithmetic calculator features the following:
  3.  *
  4.  *    + uses most operators found in the C language
  5.  *    + 'if-else' and 'while-break' flow control constructs
  6.  *    + "edit", "list", "load", "save", "run" and "exit" commands
  7.  *    + built-in line oriented editor
  8.  *    + built-in functions (expandable)
  9.  *
  10.  * The program is composed of 4 modules, the main keyboard command
  11.  * interpreter including all of the command handlers; the token parser;
  12.  * the statement parser; and the p-code program interpreter.
  13.  *
  14.  * COMMAND INTERPRETER
  15.  *
  16.  * The command interpreter prompts for a line of input from the console,
  17.  * hands it off to the parser and then to the p-code interpreter
  18.  * to be executed. The result of the STATEMENT is then printed using the
  19.  * current number radix (see BUILT-IN FUNCTION base(), below).
  20.  *
  21.  * EDITOR
  22.  *
  23.  * The line editor is similar in concept to the editor available in MS-BASIC.
  24.  * By ignoring TAB codes in program text, it was possible to keep the editor
  25.  * code extremely simple. Editor commands are:
  26.  *
  27.  *    ^E ^X - display previous/next line in program buffer (up/down)
  28.  *    ^S ^D - move cursor left/right
  29.  *    ^W    - "window" 22 lines of program buffer around current line
  30.  *    ^C    - enter character-insert mode, terminated with CR or LF
  31.  *    ^V    - enter line-insert mode, terminated with CR or LF
  32.  *    ^B    - delete character under cursor
  33.  *    ^Y    - delete current line
  34.  *
  35.  * Since the editor requires that a blank line always exist at the end of
  36.  * the buffer, there is no need for a line APPEND command.
  37.  *
  38.  * LANGUAGE SYNTAX
  39.  *
  40.  * CONSTANTS
  41.  *
  42.  * Constants may be either decimal, hexadecimal with a leading "0x" like
  43.  * in C or octal with a leading "0". Strings are delimited with a quote,
  44.  * but unlike C they may be terminated with a newline instead of a close
  45.  * quote. All the standard character escapes ('\n', '\r', etc.) may be
  46.  * used within strings.
  47.  *
  48.  * VARIABLES
  49.  *
  50.  * Only 52 global variables are available, these are referenced by a SINGLE
  51.  * lower or upper case letter (a-z and A-Z).
  52.  *
  53.  * OPERATORS
  54.  *
  55.  * Most standard C operators are available:
  56.  *
  57.  *    +  -  /  *  %  !  ~  &  &&  |  ||  ^  <<  >>  <  <=  >  >=  ==  !=
  58.  *    =  ,  (  )
  59.  *
  60.  * The address operator is "@" instead of "&" and may be used only in front
  61.  * of a variable reference. All other operators behave as expected.
  62.  *
  63.  * EXPRESSIONS
  64.  *
  65.  * Parenthesized expressions are allowed. An expression may be terminated
  66.  * with either a newline or a semicolon.
  67.  *
  68.  * STATEMENTS
  69.  *
  70.  * Statements may be either an expression or a list of expressions delimited
  71.  * with "{" and "}" like in C. The "if-else" and "while-break" constructs
  72.  * behave as in C.
  73.  *
  74.  * BUILT-IN FUNCTIONS
  75.  *
  76.  * Since this program was designed to be expandable, it currently offers
  77.  * only a few built-in functions. These are:
  78.  *
  79.  *    new()      - erase the program buffer
  80.  *    edit(n)    - envoke the editor at line "n"
  81.  *    list()     - list the program buffer to CON:
  82.  *    save(s)    - save the program buffer in a file named "s"
  83.  *    load(s)    - load program buffer from file named "s"
  84.  *    stop(n)    - stop the program and print the integer "n"
  85.  *    exit()     - exit to CP/M
  86.  *    base(n)    - change output number base
  87.  *    printf(..) - just like the standard printf() found in C
  88.  *    nl()       - output a newline to CON:
  89.  *    putn(n)    - output integer n in current output number base
  90.  *    getn(v)    - read an integer value from CON: to the address at v
  91.  *    run(s)     - chain to another program
  92.  *    debug(n)   - enable/disable calculator debug print statements
  93.  *
  94.  * OPERATION
  95.  *
  96.  * The program uses two buffers, one contains the program source lines
  97.  * (char *Prog[]) and the other a tokenized, RPN representation of the
  98.  * source (struct Opstk[]). The token parser and statement parser convert
  99.  * the source buffer into one-character tokens and stack them in Reverse
  100.  * Polish Notation (RPN) onto the Operator/Operand stack (Opstk). The
  101.  * p-code interpreter then scans through the stack and performs each
  102.  * operation in sequence. Results of operations are kept on a "value"
  103.  * stack (int Valstk[]). All built-in functions must maintain the integrity
  104.  * of this stack, since no stack frame exists to restore the stack pointer
  105.  * on exit from the function.
  106.  */
  107. #include <stdio.h>
  108. #define DEBUG 1
  109.  
  110. /*
  111.  * Tokens
  112.  */
  113. #define T_EOL        '.'
  114. #define T_SEMICOLON    ';'
  115. #define T_EOF        'z'
  116. #define T_POP        'p'
  117. #define T_CONST        'C'
  118. #define T_STRING    'S'
  119. #define T_SYMBOL    'Y'
  120. #define T_LBRACE    '{'
  121. #define T_RBRACE    '}'
  122. #define T_LPAREN    '('
  123. #define T_RPAREN    ')'
  124. #define T_COMMA        ','
  125. #define T_ASSIGN    '='
  126. #define T_POINT        '$'
  127. #define T_ADDR        '@'
  128. #define T_MUL        '*'
  129. #define T_DIV        '/'
  130. #define T_MOD        '%'
  131. #define T_ADD        '+'
  132. #define T_SUB        '-'
  133. #define T_NEG        '_'
  134.  
  135. #define T_SHL        'L'
  136. #define T_SHR        'R'
  137. #define T_LT        '<'
  138. #define T_LE        'l'
  139. #define T_GT        '>'
  140. #define T_GE        'g'
  141. #define T_EQ        'q'
  142. #define T_NE        'n'
  143.  
  144. #define T_NOT        '~'
  145. #define T_AND        '&'
  146. #define T_XOR        '^'
  147. #define T_IOR        '|'
  148. #define T_LNOT        '!'
  149. #define T_LAND        'a'
  150. #define T_LIOR        'o'
  151.  
  152. #define T_FUNC        'F'
  153.  
  154. #define T_IF        'i'
  155. #define T_ELSE        'e'
  156. #define T_WHILE        'w'
  157. #define T_BREAK        'b'
  158.  
  159. /*
  160.  * Program line buffer
  161.  */
  162. #define MAXLINES 128    /* max length of a program */
  163. char *Prog[ MAXLINES ];
  164. int Progptr, Progtop;    /* program current line and last line pointer */
  165. char Source;        /* set when parsing from Prog[] buffer */
  166.  
  167. /*
  168.  * Default program file name
  169.  */
  170. char Filenm[ 16 ];
  171.  
  172. /*
  173.  * Operator/Operand buffer - contains tokenized version of source lines.
  174.  */
  175. #define MAXOPS 1024
  176. struct {
  177.     char o_token;
  178.     int o_value;
  179. } Opstk[ MAXOPS ];
  180. int Opptr;        /* current p-code pointer */
  181. int Opsp;        /* size of buffer */
  182.  
  183. /*
  184.  * Value (working) stack
  185.  */
  186. #define MAXVALS 128
  187. int Valstk[ MAXVALS ];
  188. int Valsp;        /* top of stack ptr */
  189.  
  190. /* macro returns value on top of stack: */
  191. #define TOS (Valstk[Valsp-1])
  192.  
  193. /*
  194.  * Built-in Functions and jump table
  195.  */
  196. #define MAXFUNCS 14
  197. int f_printf(), f_base(), f_nl(), f_putn(), f_getn(), f_run(), f_debug(),
  198.     f_new(), f_edit(), f_list(), f_save(), f_load(), exit(), f_stop();
  199. struct _functab {
  200.     char *f_name;
  201.     int (*f_addr)();
  202. } Functab[ MAXFUNCS ];
  203.  
  204. /*
  205.  * Keyword lookup table
  206.  */
  207. #define MAXKEYS 4
  208. struct _keytab {
  209.     char *k_name;
  210.     char k_value;
  211. } Keytab[ MAXKEYS ];
  212.  
  213. /*
  214.  * Symbol Table    - symbols are referenced by a single letter (a-z or A-Z)
  215.  */
  216. int Symbols[ 52 ];
  217.  
  218. /*
  219.  * String table
  220.  */
  221. #define MAXSTRINGS 1024
  222. char *Strings;
  223. int Nextstr;    
  224.  
  225. /*
  226.  * "if" and "while" stacks
  227.  */
  228. #define MAXIFS 10
  229. #define MAXWHILES 10
  230. int Ifstk[ MAXIFS ], Whstk[ MAXWHILES ];
  231. char Ifsp, Whsp;    /* top of stack ptrs */
  232.  
  233. /*
  234.  * Miscellaneous
  235.  */
  236. int Level;    /* current lexical level */
  237. int Parens;    /* # of open parens (for error checking) */
  238. int Commas;    /* # of commas encountered in statement (argument count-1) */
  239. char Token;    /* current input token */
  240. int Value;    /* and its value */
  241. #ifdef DEBUG
  242. char Debug;    /* interpreter debug flag */
  243. #endif
  244. char Eol;    /* set when end of line encountered */
  245. char Line[80];    /* input line, when not parsing from Prog[] buffer */
  246. char *Lineptr;    /* points to next character in either Line[] or Prog[] */
  247. char *Ofmt;    /* current output format (set by "base" command) */
  248. int Error;    /* set if on error */
  249.  
  250. char *skipws();
  251.  
  252. /*************************************************************
  253. *                        MAIN PROGRAM                        *
  254. *************************************************************/
  255. main()
  256. {
  257.     initialize();
  258.     for ( ;; )
  259.     {
  260.         reset();
  261.         prompt();
  262.         if ( gets( Line ) )
  263.         {
  264.             /*
  265.              * input line was not "run" - assume it's
  266.              * a valid statement. Attempt to parse the
  267.              * input line, generate pseudo-code and
  268.              * evaluate it.
  269.              */
  270.             Source = 0;
  271.             getoken();
  272.             do
  273.                 statement();
  274.             while ( !(Eol || Error) );
  275.             if ( !Error )
  276.             {
  277.                 evaluate();
  278.                 putresult( pop() );
  279.             }
  280.         }
  281.     }
  282. }
  283.  
  284. /*************************************************************
  285. *                     LEXICAL ANALYZER                       *
  286. *************************************************************/
  287. getoken()
  288. {
  289.     /*
  290.      * Lexical Analyzer. Gets next token from the input line
  291.      * pointed to by "Lineptr" and advances "Lineptr" to next
  292.      * character. If end of input line is encountered, the
  293.      * "Eol" flag is set.
  294.      */
  295.     char *cp, buf[ 128 ];
  296.     int i;
  297.  
  298.     if ( Error )
  299.         goto done;
  300.  
  301.     if ( Eol )
  302.     {
  303.         /*
  304.          * Found end of line, time to get a new line.
  305.          */
  306.         Eol = 0;
  307.         if ( Source )
  308.         {
  309.             /*
  310.              * We're executing a program. Get next line of
  311.              * input from program buffer.
  312.              */
  313.             if ( Progptr == Progtop )
  314.                 /*
  315.                  * End of program buffer.
  316.                  */
  317.                 goto done;
  318.             else
  319.                 Lineptr = Prog[ Progptr++ ];
  320.         }
  321.         else
  322.         {
  323.             /*
  324.              * Immediate mode. Check if lexical end of
  325.              * statement was not yet found.
  326.              */
  327.             if ( Level )
  328.             {
  329.                 prompt();
  330.                 gets( Line );
  331.             }
  332.             Lineptr = Line;
  333.         }
  334. #ifdef DEBUG
  335.         if ( Debug )
  336.             printf( "$%3d: %s\n", Progptr, Lineptr );
  337. #endif
  338.     }
  339.     /*
  340.      * skip white space
  341.      */
  342.     Lineptr = skipws( Lineptr );
  343.  
  344.     if ( ! *Lineptr )
  345.     {
  346.         Eol = 1;
  347.         Token = T_EOL;
  348.     }
  349.     else if ( *Lineptr == '0' )
  350.     {
  351.         /*
  352.          * Check if it's a hex or octal constant
  353.          */
  354.         Token = T_CONST;
  355.         ++Lineptr;
  356.         if ( toupper( *Lineptr ) == 'X' )
  357.         {
  358.             ++Lineptr;
  359.             for ( cp = buf; ishexdigit( *Lineptr ); )
  360.                 *cp++ = *Lineptr++;
  361.             *cp = 0;
  362.             sscanf( buf, "%x", &Value );
  363.         }
  364.         else if ( isdigit( *Lineptr ) )
  365.         {
  366.             for ( cp = buf; isoctdigit( *Lineptr ); )
  367.                 *cp++ = *Lineptr++;
  368.             *cp = 0;
  369.             sscanf( buf, "%o", &Value );
  370.         }
  371.         else
  372.             Value = 0;
  373.     }
  374.     else if ( *Lineptr == '"' )
  375.     {
  376.         /*
  377.          * It's a string constant. String constants are terminated
  378.          * by either the second quote encountered, or end of line.
  379.          * Value becomes the address of the string.
  380.          */
  381.         ++Lineptr;
  382.         for ( cp = buf; *Lineptr && *Lineptr != '"'; )
  383.             charescape( &cp );
  384.         if ( *Lineptr )
  385.             ++Lineptr;
  386.         Value = *cp = 0;
  387.         Token = T_STRING;
  388.         /*
  389.          * Check if string is duplicated somewhere in string table.
  390.          */
  391.         for ( cp=Strings; cp<Strings+Nextstr; cp += strlen(cp)+1 )
  392.         {
  393.             if ( ! strcmp( cp, buf ) )
  394.             {
  395.                 Value = cp;
  396.                 break;
  397.             }
  398.         }
  399.  
  400.         if ( ! Value )
  401.         {
  402.             /*
  403.              * String is unique - make a new entry in string
  404.              * string table.
  405.              */
  406.             if ( (i = Nextstr + strlen( buf ) + 1) > MAXSTRINGS )
  407.                 err( "string space overflow" );
  408.             else
  409.             {
  410.                 Value = &Strings[ Nextstr ];
  411.                 strcpy( Value, buf );
  412.                 Nextstr = i;
  413.             }
  414.         }
  415.     }
  416.     else if ( isdigit( *Lineptr ) )
  417.     {
  418.         /*
  419.          * It's a numeric constant, "Value" will be its value.
  420.          */
  421.         Token = T_CONST;
  422.         for ( cp = buf; isdigit( *Lineptr ); )
  423.             *cp++ = *Lineptr++;
  424.         *cp = 0;
  425.         Value = atoi( buf );
  426.     }
  427.     else if ( Value = isfunc() )
  428.     {
  429.         /*
  430.          * It's a built-in function, "Value" will be the index
  431.          * into the function jump table.
  432.          */
  433.         Token = T_FUNC;
  434.         --Value;
  435.     }
  436.     else if ( Token = iskeyword() )
  437.         ;
  438.     else if ( Token = isoperator() )
  439.         /*
  440.          * It's a binary operator
  441.          */
  442.         ;
  443.     else if ( isalpha( *Lineptr ) )
  444.     {
  445.         /*
  446.          * It's a variable reference
  447.          */
  448.         Token = T_SYMBOL;
  449.         if ( 'A'<=*Lineptr && *Lineptr<='Z' )
  450.             Value = *Lineptr - 'A';
  451.         else
  452.             Value = (toupper( *Lineptr ) - 'A') + 26;
  453.         ++Lineptr;
  454.     }
  455.     else
  456.     {
  457.         /*
  458.          * Bad character in input line
  459.          */
  460.         err( "syntax error" );
  461. done:
  462.         Eol = 1;    /* make immediate mode commands give up */
  463.         Source = 0;    /* make run() give up */
  464.         Token = T_EOF;    /* make statement() give up */
  465.     }
  466.  
  467.     return Token;
  468. }
  469.  
  470. char *
  471. skipws( cp )
  472. char *cp;
  473. {
  474.     while ( *cp==' ' || *cp=='\t' )
  475.         ++cp;
  476.     return cp;
  477. }
  478.  
  479. charescape( cpp )
  480. char **cpp;
  481. {
  482.     /*
  483.      * Copy the next character from Lineptr into the string
  484.      * pointed to by "cpp". If a '\' is found, translate the
  485.      * following character(s) a la C.
  486.      */
  487.     char *cp, c;
  488.     int i;
  489.  
  490.     cp = *cpp;
  491.  
  492.     if ( (c = *Lineptr++) == '\\' )
  493.     {
  494.         switch ( c = *Lineptr++ )
  495.         {
  496.         case 'b': *cp++ = '\b'; break;
  497.         case 'n': *cp++ = '\n'; break;
  498.         case 't': *cp++ = '\t'; break;
  499.         case 'f': *cp++ = '\f'; break;
  500.         case 'r': *cp++ = '\r'; break;
  501.         case '0':
  502.         case '1':
  503.             sscanf( Lineptr-1, "%o", &i );
  504.             Lineptr += 2;
  505.             *cp++ = i;
  506.             break;
  507.         default: *cp++ = c;
  508.         }
  509.     }
  510.     else
  511.         *cp++ = c;
  512.  
  513.     *cpp = cp;
  514. }
  515.  
  516. isfunc()
  517. {
  518.     /*
  519.      * Check if string pointed to by "Lineptr" is the name of a
  520.      * built-function, return the function jump table index+1 if
  521.      * so and bump "Lineptr" to next character.
  522.      * Return 0 if not a function.
  523.      */
  524.     char *cp, *bp, buf[ 80 ];
  525.     int funcno, i;
  526.  
  527.     /*
  528.      * copy the name from input line buffer to a local buffer so
  529.      * we can use it to make a proper comparison to function names.
  530.      */
  531.     for ( cp=Lineptr, bp=buf; isalpha( *cp ); )
  532.         *bp++ = *cp++;
  533.     *bp = 0;
  534.  
  535.     /*
  536.      * compare it to all of the function names we know about.
  537.      */
  538.     for ( funcno = i = 0; i < MAXFUNCS; ++i )
  539.     {
  540.         if ( ! strcmp( buf, Functab[ i ].f_name ) )
  541.         {
  542.             funcno = i + 1;
  543.             Lineptr = cp;
  544.             break;
  545.         }
  546.     }
  547.  
  548.     return funcno;
  549. }
  550.  
  551. iskeyword()
  552. {
  553.     /*
  554.      * Check if string pointed to by "Lineptr" is a keyword.
  555.      * Return the keyword's token value and and bump "Lineptr"
  556.      * to next character, or 0 if not a keyword.
  557.      */
  558.     char *cp, *bp, buf[ 80 ];
  559.     char keyno;
  560.     int i;
  561.  
  562.     /*
  563.      * copy the name from input line buffer to a local buffer so
  564.      * we can use it to make a proper comparison to keywords.
  565.      */
  566.     for ( cp=Lineptr, bp=buf; isalpha( *cp ); )
  567.         *bp++ = *cp++;
  568.     *bp = 0;
  569.  
  570.     /*
  571.      * compare it to all of the keywords.
  572.      */
  573.     for ( keyno = i = 0; i < MAXKEYS; ++i )
  574.     {
  575.         if ( ! strcmp( buf, Keytab[ i ].k_name ) )
  576.         {
  577.             keyno = Keytab[ i ].k_value;
  578.             Lineptr = cp;
  579.             break;
  580.         }
  581.     }
  582.  
  583.     return keyno;
  584. }
  585.  
  586. isoperator()
  587. {
  588.     /*
  589.      * Check if string pointed to by "Lineptr" is an operator,
  590.      * return its token value and bump "Lineptr" to next character.
  591.      */
  592.     int tkn;
  593.     char c;
  594.  
  595.     switch ( *Lineptr )
  596.     {
  597.     case ',':
  598.         ++Commas;
  599.         tkn = T_COMMA;
  600.         break;
  601.     case '=':
  602.         if ( Lineptr[1] == '=' )
  603.         {
  604.             tkn = T_EQ;
  605.             ++Lineptr;
  606.         }
  607.         else
  608.             tkn = T_ASSIGN;
  609.         break;
  610.     case '!':
  611.         if ( Lineptr[1] == '=' )
  612.         {
  613.             tkn = T_NE;
  614.             ++Lineptr;
  615.         }
  616.         else
  617.             tkn = T_LNOT;
  618.         break;
  619.     case '<':
  620.         if ( (c = Lineptr[1]) == '<' )
  621.         {
  622.             tkn = T_SHL;
  623.             ++Lineptr;
  624.         }
  625.         else if ( c == '=' )
  626.         {
  627.             tkn = T_LE;
  628.             ++Lineptr;
  629.         }
  630.         else
  631.             tkn = T_LT;
  632.         break;
  633.     case '>':
  634.         if ( (c = Lineptr[1]) == '>' )
  635.         {
  636.             tkn = T_SHR;
  637.             ++Lineptr;
  638.         }
  639.         else if ( c == '=' )
  640.         {
  641.             tkn = T_GE;
  642.             ++Lineptr;
  643.         }
  644.         else
  645.             tkn = T_GT;
  646.         break;
  647.     case '(':
  648.         ++Parens;
  649.         tkn = T_LPAREN;
  650.         break;
  651.     case ')':
  652.         --Parens;
  653.         tkn = T_RPAREN;
  654.         break;
  655.     case '&':
  656.         if ( Lineptr[1] == '&' )
  657.         {
  658.             tkn = T_LAND;
  659.             ++Lineptr;
  660.         }
  661.         else
  662.             tkn = T_AND;
  663.         break;
  664.     case '|':
  665.         if ( Lineptr[1] == '|' )
  666.         {
  667.             tkn = T_LIOR;
  668.             ++Lineptr;
  669.         }
  670.         else
  671.             tkn = T_IOR;
  672.         break;
  673.     default:
  674.         if ( instr( *Lineptr, ";@{}*/%+-^~" ) )
  675.             tkn = *Lineptr;
  676.         else
  677.             tkn = 0;
  678.     }
  679.  
  680.     if ( tkn )
  681.         ++Lineptr;
  682.  
  683.     return tkn;
  684. }
  685.  
  686. skipnl()
  687. {
  688.     while ( Token==T_EOL )
  689.         getoken();
  690. }
  691.  
  692. /*************************************************************
  693. *                   STATEMENT PARSER                         *
  694. **************************************************************/
  695. statement()
  696. {
  697.     /*
  698.      * Parse a statement. The BNF for statements is:
  699.      *    <statement> := <expression> <eol> |
  700.      *                   '{' <statement-list> '}'
  701.      * and, of course:
  702.      *   <statement-list> := <eol> |
  703.      *                       <statement> <eol> |
  704.      *                       <statement-list> <statement> <eol>
  705.      * finally:
  706.      *   <eol> := '\n' |
  707.      *            ';' |
  708.      *            ';' '\n'
  709.      */
  710. start:;
  711.  
  712.     switch ( Token )
  713.     {
  714.     case T_EOL:
  715.         getoken();
  716.         goto start;
  717.     case T_SEMICOLON:
  718.         getoken();
  719.         skipnl();
  720.     case T_EOF:
  721.         break;
  722.     case T_IF:
  723.         ++Level;
  724.         doif();
  725.         if ( Token!=T_EOF )
  726.             --Level;
  727.         break;
  728.     case T_ELSE:
  729.         doelse();
  730.         break;
  731.     case T_WHILE:
  732.         ++Level;
  733.         dowhile();
  734.         if ( Token!=T_EOF )
  735.             --Level;
  736.         break;
  737.     case T_BREAK:
  738.         dobreak();
  739.         break;
  740.     case T_LBRACE:
  741.         ++Level;
  742.         getoken();
  743.         do
  744.             statement();
  745.         while ( !Error && Token != T_RBRACE && Token!=T_EOF );
  746.  
  747.         if ( Token!=T_EOF )
  748.         {
  749.             getoken();
  750.             --Level;
  751.         }
  752.         break;
  753.     case T_RBRACE:
  754.         if ( !Level )
  755.             err( "'{' missing" );
  756.         break;
  757.     case T_RPAREN:
  758.         if ( Parens<0 )
  759.             err( "'(' missing" );
  760.         break;
  761.     default:
  762.         expression();
  763.         generate( T_POP, 0 );
  764.     }
  765.  
  766.     if ( Token == T_EOF && Level )
  767.         err( "incomplete statement" );
  768. }
  769.  
  770. doif()
  771. {
  772.     /*
  773.      * Parse an "if" statement:
  774.      *    'if' <expression> <statement>
  775.      */
  776.  
  777.     getoken();
  778.     expression();
  779.     /*
  780.      * Save current operator stack pointer for backpatching later.
  781.      * This is pushed onto a stack so that it will be available for
  782.      * possible future "else" statements.
  783.      */
  784.     pushif( Opsp );
  785.     /*
  786.      * generate a "jump if value on stack is zero" code.
  787.      */
  788.     generate( T_IF, -1 );
  789.     /*
  790.      * parse the <statement> part, then backpatch the above
  791.      * "jump if zero" opcode to point to next program line.
  792.      */
  793.     statement();
  794.     skipnl();
  795.     if ( Token == T_ELSE )
  796.         doelse();
  797.     Opstk[ popif() ].o_value = Opsp;
  798. }
  799.  
  800. doelse()
  801. {
  802.     /*
  803.      * Parse an "else" statement.
  804.      *    'if' <expression> <statement> 'else' <statement>
  805.      */
  806.     int p;
  807.  
  808.     /*
  809.      * generate a "jump to end of if-else" opcode, then backpatch
  810.      * the "jump if zero" opcode generated by doif() to point to
  811.      * here.
  812.      */
  813.     getoken();
  814.     p = popif();
  815.     pushif( Opsp );
  816.     generate( T_WHILE, -1 );
  817.     Opstk[ p ].o_value = Opsp;
  818.     statement();
  819. }
  820.  
  821. dowhile()
  822. {
  823.     /*
  824.      * Parse a "while" statement.
  825.      *     'while' <expression> <statement>
  826.      */
  827.     int p;
  828.  
  829.     /*
  830.      * Save program counter of <expression> part for
  831.      * "jump to top of loop" code to be generated later.
  832.      */
  833.     p = Opsp;
  834.     getoken();
  835.     expression();
  836.     /*
  837.      * Save operator stack pointer of "jump if top of stack is zero"
  838.      * code (break out of loop code). This is pushed onto a stack
  839.      * so that it will be available for future "break" statements.
  840.      */
  841.     pushwhile( Opsp );
  842.     generate( T_IF, -1 );
  843.     /*
  844.      * Parse the <statement> part, then generate code to jump back to
  845.      * top of loop.
  846.      */
  847.     statement();
  848.  
  849.     generate( T_WHILE, p );
  850.     /*
  851.      * Backpatch "jump if zero" opcode generated above.
  852.      */
  853.     Opstk[ popwhile() ].o_value = Opsp;
  854. }
  855.  
  856. dobreak()
  857. {
  858.     /*
  859.      * Parse a "break" statement. Generate code to push a zero onto
  860.      * stack, then jump to the loop end test at top of loop. This test
  861.      * will find a zero on the stack and jump to the end of the loop.
  862.      */
  863.     getoken();
  864.     generate( T_CONST, 0 );
  865.     generate( T_WHILE, pushwhile( popwhile() ) );
  866. }
  867.  
  868. expression()
  869. {
  870.     /*
  871.      * Parse an expression. Expressions have the following syntax:
  872.      *    <expression> := <primary> <operator> <primary>
  873.      * so the first thing to look for is a primary.
  874.      */
  875.     int lvalue;
  876.     char notempty;
  877.  
  878.     /*
  879.      * Check if end of expression first
  880.      */
  881.  
  882.     if ( endofexpr() )
  883.         return 0;
  884.     else
  885.     {
  886.         notempty = 1;    /* assume not the empty expression: "()" */
  887.         if ( !(lvalue = primary()) )
  888.             err( "bad expression" );
  889.         else if ( lvalue == 2 )
  890.             notempty = 0;    /* it was the expression "()" */
  891.         else if ( endofexpr() )
  892.         {
  893.             /*
  894.              * The <primary> was an lvalue (variable reference)
  895.              * and the stack will contain its address. Generate
  896.              * code to load an integer from that address.
  897.              */
  898.             if ( lvalue < 0 )
  899.                 generate( T_POINT, 0 );
  900.         }
  901.         else
  902.             op_prim( 0, lvalue );
  903.     }
  904.     /*
  905.      * Return TRUE if it's an empty expression
  906.      */
  907.     return notempty;
  908. }
  909.  
  910. endofexpr()
  911. {
  912.     /*
  913.      * Return TRUE if current Token marks end of an expression
  914.      */
  915.     return Eol || Error ||
  916.         Token==T_RPAREN || Token==T_LBRACE ||
  917.         Token==T_RBRACE || Token==T_SEMICOLON;
  918. }
  919.  
  920. op_prim( precedence, lvalue )
  921. int precedence;    /* precedence of current <operator> */
  922. int lvalue;    /* type of current <primary>: -1 => lvalue */
  923.         /*                             0 => no <primary> (error) */
  924.         /*                             1 => rvalue */
  925. {
  926.     /*
  927.      * Parse the <operator> <primary> part of an expression.
  928.      * "precedence" is the PREVIOUS <operator>'s precedence level
  929.      * (0=low, +n=high).
  930.      */
  931.     char tkn;
  932.     int pr, lv;
  933.  
  934.     /*
  935.      * Loop until end of <expression> is found
  936.      */
  937.     while ( ! endofexpr() )
  938.     {
  939.         /*
  940.          * Get the precedence level of current <operator> ("pr").
  941.          * If it is greater than previous operator ("precedence"),
  942.          * get the next <primary> and do another <operator> <primary>
  943.          * NOTE: For left-to-right associativity, the condition
  944.          *     pr > precedence
  945.          * must be true. for right-to-left associativity,
  946.          *     pr >= precedence
  947.          * must be true (assignment operator only).
  948.          */
  949.  
  950.         if ( !(pr = binop( Token )) )
  951.         {
  952.             /*
  953.              * Found two (possibly) consecutive primaries.
  954.              */
  955.             err( "missing operator" );
  956.             break;
  957.         }
  958.  
  959.         if (
  960.             (pr>precedence && pr>0) ||
  961.             (Token==T_ASSIGN && pr>=precedence)
  962.         )
  963.         {
  964.             if ( Token == T_ASSIGN )
  965.             {
  966.                 if ( lvalue > 0 )
  967.                     err( "= needs and lvalue" );
  968.             }
  969.             else if ( lvalue < 0 )
  970.                 generate( T_POINT, 0 );
  971.  
  972.             /*
  973.              * Save the operator token and do a primary.
  974.              */
  975.             tkn = Token;
  976.             getoken();
  977.             if ( ! (lv = primary()) )
  978.                 err( "missing operand" );
  979.             /*
  980.              * Now look at the next operator. If its precedence
  981.              * is greater than this one ("tkn" above), generate
  982.              * code for it BEFORE this one.
  983.              */
  984.             lvalue = op_prim( pr, lv );
  985.  
  986.             if ( Token != T_ASSIGN && lvalue < 0 )
  987.             {
  988.                 /*
  989.                  * Next operator is not the assignment op.
  990.                  * and the current <primary> is an lvalue,
  991.                  * therefore generate a "load from address
  992.                  * on top of stack" instruction.
  993.                  */
  994.                 generate( T_POINT, 0 );
  995.                 /*
  996.                  * This makes it an rvalue now.
  997.                  */
  998.                 lvalue = 1;
  999.             }
  1000.             else if ( tkn!=T_ASSIGN && Token==T_ASSIGN )
  1001.             {
  1002.                 /*
  1003.                  * YEECH! this is the only way I know of to
  1004.                  * detect errors like: a+b=c
  1005.                  */
  1006.                 err( "= needs an lvalue" );
  1007.             }
  1008.  
  1009.             /*
  1010.              * Generate the instruction for the current operator.
  1011.              */
  1012.             if ( tkn!=T_COMMA )
  1013.                 generate( tkn, 0 );
  1014.         }
  1015.         else
  1016.             break;
  1017.     }
  1018.  
  1019.     return lvalue;
  1020. }
  1021.  
  1022. primary()
  1023. {
  1024.     /*
  1025.      * Parse a primary. Primaries have the following syntax:
  1026.      *    <primary> := <constant> |
  1027.      *                 '(' <expression> ')' |
  1028.      *                 <unary op> <primary> |
  1029.      *                 <function> <primary>
  1030.      */
  1031.     int rtn, val, savcommas, needparen;
  1032.  
  1033.     /*
  1034.      * Return value:
  1035.      *   -1 => the <primary> is an lvalue
  1036.      *    0 => not a <primary> (usually end of expr or syntax error)
  1037.      *    1 => the <primary> is an rvalue
  1038.      *    2 => the <primary> is the empty expression "()"
  1039.      */
  1040.     rtn = 1;
  1041.  
  1042.     switch ( Token )
  1043.     {
  1044.     case T_ADDR:    /* address operator */
  1045.         getoken();
  1046.         if ( Token != T_SYMBOL )
  1047.             err( "@ not followed by a variable" );
  1048.         else
  1049.         {
  1050.             Token = T_CONST;
  1051.             Value = &Symbols[ Value ];
  1052.         }
  1053.         goto const;
  1054.     case T_SYMBOL:    /* a symbol */
  1055.         rtn = -1;
  1056.     case T_CONST:    /* a constant */
  1057.     case T_STRING:    /* a string constant */
  1058.         ;
  1059. const:
  1060.         generate( Token, Value );
  1061.         getoken();
  1062.         break;
  1063.     case T_LPAREN:    /* a parenthesized expression */
  1064.         if ( getoken() == T_RPAREN )
  1065.             rtn = 2;    /* special empty expression: () */
  1066.         else
  1067.             expression();
  1068.         if ( Token != T_RPAREN )
  1069.         {
  1070.             err( "missing ')'" );
  1071.             rtn = 0;
  1072.         }
  1073.         else
  1074.             getoken();
  1075.         break;
  1076.     case T_SUB:    /* unary - */
  1077.         /*
  1078.          * The lexical analyzer is not smart enough to recognize
  1079.          * unary operators (+ and -), that's why we have to do
  1080.          * it here
  1081.          */
  1082.         getoken();
  1083.         expression();
  1084.         generate( T_NEG, 0 );
  1085.         break;
  1086.     case T_NOT:    /* unary ~ */
  1087.         getoken();
  1088.         expression();
  1089.         generate( T_NOT, 0 );
  1090.         break;
  1091.     case T_ADD:    /* unary + */
  1092.         getoken();
  1093.         expression();
  1094.         break;
  1095.     case T_LNOT:    /* unary ! */
  1096.         getoken();
  1097.         expression();
  1098.         generate( T_LNOT, 0 );
  1099.         break;
  1100.     case T_FUNC:    /* built-in function */
  1101.         val = Value;
  1102.         /*
  1103.          * Keep track of number of arguments pushed onto stack...
  1104.          */
  1105.         savcommas = Commas;
  1106.         Commas = needparen = 0;
  1107.         if ( getoken() == T_LPAREN )
  1108.         {
  1109.             getoken();
  1110.             needparen = 1;
  1111.         }
  1112.         if ( !expression() )
  1113.             --Commas;   /* found the empty expression "()" */
  1114.  
  1115.         if ( needparen )
  1116.         {
  1117.             if ( Token!=T_RPAREN )
  1118.                 err( "missing ')'" );
  1119.             getoken();
  1120.         }
  1121.         /*
  1122.          * set # of arguments
  1123.          */
  1124.         generate( T_COMMA, Commas+1 );
  1125.         generate( T_FUNC, val );
  1126.         Commas = savcommas;
  1127.         break;
  1128.     default:
  1129.         /*
  1130.          * Not a primary
  1131.          */
  1132.         rtn = 0;
  1133.     }
  1134.     return rtn;
  1135. }
  1136.  
  1137. binop( op )
  1138. char op;
  1139. {
  1140.     /*
  1141.      * Determine if "op" is a binary operator and return its
  1142.      * precedence level if so. If not, return 0.
  1143.      */
  1144.     switch ( op )
  1145.     {
  1146.     case T_COMMA:
  1147.         return 1;
  1148.     case T_ASSIGN:
  1149.         return 2;
  1150.     case T_IOR:
  1151.         return 3;
  1152.     case T_XOR:
  1153.         return 4;
  1154.     case T_AND:
  1155.         return 5;
  1156.     case T_LT:
  1157.     case T_GT:
  1158.     case T_LE:
  1159.     case T_GE:
  1160.     case T_EQ:
  1161.     case T_NE:
  1162.         return 6;
  1163.     case T_LAND:
  1164.     case T_LIOR:
  1165.         return 7;
  1166.     case T_SHL:
  1167.     case T_SHR:
  1168.         return 8;
  1169.     case T_ADD:
  1170.     case T_SUB:
  1171.         return 9;
  1172.     case T_MUL:
  1173.     case T_DIV:
  1174.     case T_MOD:
  1175.         return 10;
  1176.     case T_NOT:
  1177.     case T_LNOT:
  1178.         return 11;
  1179.     }
  1180.     return 0;
  1181. }
  1182.  
  1183. generate( tkn, val )
  1184. char tkn;
  1185. {
  1186.     /*
  1187.      * Push the given token and value onto the Operator/Operand stack.
  1188.      */
  1189.     if ( Opsp < MAXOPS )
  1190.     {
  1191.         Opstk[ Opsp ].o_token = tkn;
  1192.         Opstk[ Opsp ].o_value = val;
  1193. #ifdef DEBUG
  1194.         if ( Debug )
  1195.             printf( "+%3d: %c %d\n", Opsp, tkn, val );
  1196. #endif
  1197.         ++Opsp;
  1198.     }
  1199.     else
  1200.         err( "program too long" );
  1201. }
  1202.  
  1203. pushif( n )
  1204. {
  1205.     if ( Ifsp < MAXIFS )
  1206.         Ifstk[ Ifsp++ ] = n;
  1207.     else
  1208.         err( "too many nested 'if's" );
  1209.     return n;
  1210. }
  1211.  
  1212. popif()
  1213. {
  1214.     if ( Ifsp )
  1215.         return Ifstk[ --Ifsp ];
  1216.     err( "mismatched 'else'" );
  1217. }
  1218.  
  1219. pushwhile( n )
  1220. {
  1221.     if ( Whsp < MAXWHILES )
  1222.         Whstk[ Whsp++ ] = n;
  1223.     else
  1224.         err( "too many nested 'while's" );
  1225.     return n;
  1226. }
  1227.  
  1228. popwhile()
  1229. {
  1230.     if ( Whsp )
  1231.         return Whstk[ --Whsp ];
  1232.     err( "'break' not inside a 'while'" );
  1233. }
  1234.  
  1235. /*************************************************************
  1236. *                 EXPRESSION EVALUATOR                       *
  1237. **************************************************************/
  1238. /*
  1239.  * NOTE: The comments make reference to "lvalues" and "rvalues". These
  1240.  * are attributes of <primaries> (primaries, for the layman, are things
  1241.  * like constants and variables, and parenthesized expressions. If you
  1242.  * don't know what an expression is, you shouldn't be a reading this!).
  1243.  * If a <primary> is an "lvalue", it means that it can usually be found on
  1244.  * LEFT-HAND side of an assignment operator. "rvalues" can only be found
  1245.  * on the RIGHT-HAND side of an assignment. Simply stated, only things like
  1246.  * variables can be used as both "lvalues" and "rvalues", whereas things
  1247.  * like constants and parenthesized expressions can only be "rvalues" since
  1248.  * it wouldn't make sense to say: 12 = 5.
  1249.  */
  1250. evaluate()
  1251. {
  1252.     /*
  1253.      * Evaluate an expression by popping operators and operands
  1254.      * from the Operator/Operand stack and performing each indicated
  1255.      * operation.
  1256.      */
  1257.     int val, *ip, i;
  1258.     char op;
  1259.  
  1260.     for ( Opptr=0; Opptr<Opsp; ++Opptr )
  1261.     {
  1262.         op = Opstk[ Opptr ].o_token;
  1263.         val = Opstk[ Opptr ].o_value;
  1264.  
  1265.         /*
  1266.          * Stop program if ^C is entered.
  1267.          */
  1268.         if ( bios( 2, 0 ) && getkey()==3 )
  1269.             break;
  1270. #ifdef DEBUG
  1271.         if ( Debug )
  1272.         {
  1273.             printf( "-%3d: %c %d:", Opptr, op, val );
  1274.             for ( i=0; i<Valsp; ++i )
  1275.                 printf( " %d", Valstk[ i ] );
  1276.             newline();
  1277.         }
  1278. #endif
  1279.         switch ( op )
  1280.         {
  1281.         case T_CONST:
  1282.         case T_STRING:
  1283.             push( val );
  1284.             break;
  1285.         case T_SYMBOL:
  1286.             /*
  1287.              * Push the address of a variable
  1288.              */
  1289.             push( &Symbols[ val ] );
  1290.             break;
  1291.         case T_POINT:
  1292.             /*
  1293.              * Fetch an integer from address on top of stack.
  1294.              * This usually follows a T_SYMBOL when the symbol
  1295.              * is not being used as an "lvalue".
  1296.              */
  1297.             ip = pop();
  1298.             push( *ip );
  1299.             break;
  1300.         case T_IF:
  1301.             /*
  1302.              * Jump to the program line # given by operand
  1303.              * if top of stack is zero.
  1304.              */
  1305.             if ( !pop() )
  1306.                 Opptr = val - 1;
  1307.             break;
  1308.         case T_WHILE:
  1309.             /*
  1310.              * Jump to the program line # given by operand
  1311.              */
  1312.             Opptr = val - 1;
  1313.             break;
  1314.         case T_POP:
  1315.             /*
  1316.              * Pop the stack. Usually follows an <expression>
  1317.              */
  1318.             pop();
  1319.             break;
  1320.         case T_COMMA:
  1321.             /*
  1322.              * Set # of arguments on stack
  1323.              */
  1324.             Commas = val;
  1325.             break;
  1326.         case T_FUNC:
  1327.             /*
  1328.              * Execute a built-in function
  1329.              */
  1330.             (*Functab[ Opstk[ Opptr ].o_value ].f_addr)();
  1331.             break;
  1332.         case T_ASSIGN:
  1333.             /*
  1334.              * Assignment operator: The item on top of stack is
  1335.              * the "rvalue", second on stack is the "lvalue"
  1336.              * (an address where to store the "rvalue"). The
  1337.              * "rvalue" gets pushed back on top of the stack.
  1338.              */
  1339.             val = pop();
  1340.             ip = pop();
  1341.             push( *ip = val );
  1342.             break;
  1343.         case T_NOT:
  1344.             TOS = ~TOS;
  1345.             break;
  1346.         case T_LNOT:
  1347.             TOS = !TOS;
  1348.             break;
  1349.         case T_NEG:
  1350.             TOS = -TOS;
  1351.             break;
  1352.         default:
  1353.             /*
  1354.              * All others are binary operators.
  1355.              */
  1356.             val = pop();
  1357.             switch ( op )
  1358.             {
  1359.             case T_ADD:
  1360.                 TOS += val;
  1361.                 break;
  1362.             case T_SUB:
  1363.                 TOS -= val;
  1364.                 break;
  1365.             case T_MUL:
  1366.                 TOS *= val;
  1367.                 break;
  1368.             case T_DIV:
  1369.                 TOS /= val;
  1370.                 break;
  1371.             case T_MOD:
  1372.                 TOS %= val;
  1373.                 break;
  1374.             case T_LT:
  1375.                 TOS = TOS < val;
  1376.                 break;
  1377.             case T_GT:
  1378.                 TOS = TOS > val;
  1379.                 break;
  1380.             case T_LE:
  1381.                 TOS = TOS <= val;
  1382.                 break;
  1383.             case T_GE:
  1384.                 TOS = TOS >= val;
  1385.                 break;
  1386.             case T_EQ:
  1387.                 TOS = TOS == val;
  1388.                 break;
  1389.             case T_NE:
  1390.                 TOS = TOS != val;
  1391.                 break;
  1392.             case T_SHL:
  1393.                 TOS = TOS << val;
  1394.                 break;
  1395.             case T_SHR:
  1396.                 TOS = TOS >> val;
  1397.                 break;
  1398.             case T_AND:
  1399.                 TOS &= val;
  1400.                 break;
  1401.             case T_XOR:
  1402.                 TOS ^= val;
  1403.                 break;
  1404.             case T_IOR:
  1405.                 TOS |= val;
  1406.                 break;
  1407.             case T_LAND:
  1408.                 TOS = TOS && val;
  1409.                 break;
  1410.             case T_LIOR:
  1411.                 TOS = TOS || val;
  1412.                 break;
  1413.             default:
  1414.                 err( "parser error" );
  1415.             }
  1416.         }    
  1417.     }
  1418. }
  1419.  
  1420. push( val )
  1421. {
  1422.     if ( Valsp >= MAXVALS )
  1423.         err( "stack overflow" );
  1424.     return Valstk[ Valsp++ ] = val;
  1425. }
  1426.  
  1427. pop()
  1428. {
  1429.     if ( --Valsp < 0 )
  1430.         Valsp = 0;
  1431.     return Valstk[ Valsp ];
  1432. }
  1433.  
  1434. /*************************************************************
  1435. *                   BUILT-IN FUNCTIONS                       *
  1436. **************************************************************/
  1437. /*
  1438.  * NOTE: All functions expect the correct number of arguments on the
  1439.  * stack. These arguments are removed and exactly one argument is left in
  1440.  * their place. Thus, a built-in function is a transform that results in
  1441.  * a single rvalue.
  1442.  */
  1443. f_printf()
  1444. {
  1445.     /*
  1446.      * usage:  printf( a0, a1, ... a9 )
  1447.      * does:   do a formatted print, a la printf()
  1448.      * stacks: # of arguments printed
  1449.      */
  1450.     int a[ 10 ];
  1451.  
  1452.     getargs( 10, a );
  1453.     push( printf(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9]) );
  1454. }
  1455.  
  1456. f_base()
  1457. {
  1458.     /*
  1459.      * usage:  base( n )
  1460.      * does:   sets output number base
  1461.      * stacks: the argument n
  1462.      */
  1463.     int n;
  1464.  
  1465.     getargs( 1, &n );
  1466.  
  1467.     switch ( n )
  1468.     {
  1469.     case 8:
  1470.         Ofmt = "0%o";
  1471.         break;
  1472.     case 16:
  1473.         Ofmt = "0x%x";
  1474.         break;
  1475.     case 10:
  1476.     default:
  1477.         Ofmt = "%d";
  1478.         break;
  1479.     }
  1480.     push( n );
  1481. }
  1482.  
  1483. f_run()
  1484. {
  1485.     /*
  1486.      * usage:  run( s )
  1487.      * does:   chain to program in filename pointed to by "s". If "s"
  1488.      *         not given, executes source already in program buffer.
  1489.      * stacks: 1 if successful, 0 otherwise
  1490.      */
  1491.     char *s;
  1492.  
  1493.     if ( getargs( 1, &s ) )
  1494.     {
  1495.         Commas = 1;
  1496.         push( s );
  1497.         if ( !f_load() )
  1498.         {
  1499.             push( 0 );
  1500.             return;
  1501.         }
  1502.     }
  1503.  
  1504.     reset();
  1505.     *Line = 0;
  1506.     Source = 1;
  1507.     getoken();
  1508.     while ( Source )
  1509.         statement();
  1510.     /*
  1511.      * This function was called from evaluate(), so
  1512.      * remember to back up p-code pointer by one.
  1513.      */
  1514.     --Opptr;
  1515. }
  1516.  
  1517. f_nl()
  1518. {
  1519.     /*
  1520.      * usage:  nl()
  1521.      * does:   outputs a newline to CON:
  1522.      * stacks: a newline character (0x0a)
  1523.      */
  1524.     getargs( 0, 0 );
  1525.     newline();
  1526.     push( '\n' );
  1527. }
  1528.  
  1529. f_putn()
  1530. {
  1531.     /*
  1532.      * usage:  putn( n )
  1533.      * does:   prints numeric constant in the current number base
  1534.      * stacks: the number
  1535.      */
  1536.     int n;
  1537.  
  1538.     getargs( 1, &n );
  1539.     printf( Ofmt, n );
  1540.     push( n );
  1541. }
  1542.  
  1543. f_getn()
  1544. {
  1545.     /*
  1546.      * usage: getn( v )
  1547.      * does:   reads a number into the address at "v" (assumed to be
  1548.      *         a variable). If "v" is not given, leaves number on stack.
  1549.      * stacks: number read
  1550.      */
  1551.     int *ip, n;
  1552.     char buf[ 128 ];
  1553.  
  1554.     gets( buf );
  1555.     n = atoi( buf );
  1556.  
  1557.     if ( getargs( 1, &ip ) )
  1558.         push( *ip = n );
  1559.     else
  1560.         push( n );
  1561. }
  1562.  
  1563. f_debug()
  1564. {
  1565.     /*
  1566.      * usage: debug( v )
  1567.      * does:  sets/resets the interpreter's debug flag, depending on v
  1568.      * stacks: v
  1569.      */
  1570.     int v;
  1571.  
  1572.     getargs( 1, &v );
  1573. #ifdef DEBUG
  1574.     Debug = v;
  1575. #endif
  1576.     push( v );
  1577. }
  1578.  
  1579. f_new()
  1580. {
  1581.     /*
  1582.      * Erase the entire program buffer by freeing up all memory
  1583.      */
  1584.     getargs( 0, 0 );
  1585.     new();
  1586.     push( 0 );
  1587. }
  1588.  
  1589. new()
  1590. {
  1591.     for ( Progptr=0; Progptr<Progtop; ++Progptr )
  1592.         free( Prog[ Progptr ] );
  1593.     Progptr = Progtop = 0;
  1594. }
  1595.  
  1596. f_load()
  1597. {
  1598.     char *file, iobuf[ BUFSIZ ], rtn;
  1599.  
  1600.     if ( !getargs( 1, &file ) )
  1601.         file = Filenm;
  1602.  
  1603.     if ( *file && fopen( file, iobuf ) != -1 )
  1604.     {
  1605.         rtn = 1;
  1606.         new();
  1607.         while ( fgets( Line, iobuf ) )
  1608.         {
  1609.             Line[ strlen( Line ) - 1 ] = 0;
  1610.             if ( !makline( Progtop++, Line ) )
  1611.             {
  1612.                 puts( "file too big\n" );
  1613.                 rtn = 0;
  1614.                 break;
  1615.             }
  1616.         }
  1617.         fclose( iobuf );
  1618.     }
  1619.     else
  1620.     {
  1621.         puts( "file not found\n" );
  1622.         rtn = 0;
  1623.     }
  1624.  
  1625.     if ( rtn )
  1626.         strcpy( Filenm, file );
  1627.  
  1628.     push( rtn );
  1629.  
  1630.     return rtn;
  1631. }
  1632.  
  1633. f_save()
  1634. {
  1635.     char *file, iobuf[ BUFSIZ ], rtn;
  1636.     int i;
  1637.  
  1638.     if ( !getargs( 1, &file ) )
  1639.         file = Filenm;
  1640.  
  1641.     if ( *file && fcreat( file, iobuf ) != -1 )
  1642.     {
  1643.         for ( i=0; i<Progtop; ++i )
  1644.         {
  1645.             fputs( Prog[ i ], iobuf );
  1646.             putc( '\n', iobuf );
  1647.         }
  1648.         putc( 26, iobuf );
  1649.         fclose( iobuf );
  1650.         rtn = 1;
  1651.     }
  1652.     else
  1653.     {
  1654.         puts( "file not created\n" );
  1655.         rtn = 0;
  1656.     }
  1657.  
  1658.     if ( rtn )
  1659.         strcpy( Filenm, file );
  1660.  
  1661.     push( rtn );
  1662.  
  1663.     return rtn;
  1664. }
  1665.  
  1666. f_edit()
  1667. {
  1668.     /*
  1669.      * Program buffer editor.
  1670.      */
  1671.     char *cp, col, lastcol;
  1672.     int i, c;
  1673.  
  1674.     if ( getargs( 1, &i ) )
  1675.         Progptr = i - 1;
  1676.     push( i );
  1677.     /*
  1678.      * Initialize: do some bounds checking on current program line ptr,
  1679.      * and redraw the current line.
  1680.      */
  1681. ;start:
  1682.     col = 0;
  1683.     if ( !Progtop )
  1684.     {
  1685.         /*
  1686.          * There's always one blank line at the end of the buffer.
  1687.          * Therefore, we only need a line INSERT command, never an
  1688.          * APPEND...
  1689.          */
  1690.         Progptr = 0;
  1691.         addline( "" );
  1692.     }
  1693.     else if ( Progptr && Progptr >= Progtop )
  1694.         Progptr = Progtop - 1;
  1695.     else if ( Progptr < 0 )
  1696.         Progptr = 0;
  1697.  
  1698. redraw:
  1699.     newline();
  1700.     fmtlno( Progptr );
  1701.     puts( cp = Prog[ Progptr ] );
  1702.  
  1703.     lastcol = strlen( cp );
  1704.     if ( col > lastcol )
  1705.         col = lastcol;
  1706.  
  1707.     fmtlno( Progptr );
  1708.     for ( i=0; i<col; ++i )
  1709.         putchar( cp[i] );
  1710.  
  1711.  
  1712.     /*
  1713.      * Command loop
  1714.      */
  1715.     for ( ;; )
  1716.     {
  1717.         switch ( c = getkey() )
  1718.         {
  1719.         case '\r': /* exit */
  1720.         case '\n':
  1721.             goto done;
  1722.         case 5: /* up */
  1723.             if ( Progptr )
  1724.             {
  1725.                 --Progptr;
  1726.                 goto start;
  1727.             }
  1728.             break;
  1729.         case 24: /* down */
  1730.             if ( Progptr < Progtop-1 )
  1731.             {
  1732.                 ++Progptr;
  1733.                 goto start;
  1734.             }
  1735.             break;
  1736.         case 19: /* left */
  1737.         case 8:
  1738.             if ( col )
  1739.             {
  1740.                 putchar( '\b' );
  1741.                 --col;
  1742.             }
  1743.             break;
  1744.         case 4: /* right */
  1745.             if ( col < lastcol )
  1746.                 putchar( cp[ col++ ] );
  1747.             break;
  1748.         case 23: /* redraw window */
  1749.             newline();
  1750.             newline();
  1751.             if ( (i=Progptr-11) < 0 )
  1752.                 i = 0;
  1753.             for ( c=i; c<i+22 && c<Progtop; ++c )
  1754.                 fmtline( c );
  1755.             goto redraw;
  1756.         case 22: /* insert line mode */
  1757.             newline();
  1758.             newline();
  1759.             for ( ;; )
  1760.             {
  1761.                 fmtlno( Progptr );
  1762.                 if ( !gets( Line ) )
  1763.                     break;
  1764.                 if ( !insline( Progptr++, Line ) )
  1765.                     break;
  1766.             }
  1767.             goto start;
  1768.         case 3: /* insert character mode */
  1769.             if ( Progptr < Progtop-1 )
  1770.             {
  1771.                 for ( i=0; i<col; ++i )
  1772.                     Line[i] = cp[i];
  1773.                 gets( &Line[i] );
  1774.                 strcat( Line, &cp[i] );
  1775.                 free( cp );
  1776.                 makline( Progptr, Line );
  1777.                 goto redraw;
  1778.             }
  1779.             break;
  1780.         case 25: /* delete line */
  1781.             if ( Progptr < Progtop-1 )
  1782.             {
  1783.                 delline( Progptr );
  1784.                 goto start;
  1785.             }
  1786.             break;
  1787.         case 2: /* delete character */
  1788.             for ( i=col; i<lastcol; ++i )
  1789.                 cp[i] = cp[i+1];
  1790.             goto redraw;
  1791.         default:
  1792.             if ( ' '<=c && c<='~' && col < lastcol )
  1793.                 putchar( cp[ col++ ] = c );
  1794.             break;
  1795.         }
  1796.     }
  1797. done:
  1798.     newline();
  1799. }
  1800.  
  1801. f_list()
  1802. {
  1803.     int n[2], i;
  1804.  
  1805.     n[0] = 1;    n[1] = Progtop;
  1806.     getargs( 2, n );
  1807.  
  1808.     puts( Filenm );
  1809.     newline();
  1810.  
  1811.     for ( i=n[0]-1; i<n[1]; ++i )
  1812.         fmtline( i );
  1813.     push( 0 );
  1814. }
  1815.  
  1816. f_stop()
  1817. {
  1818.     int n;
  1819.  
  1820.     getargs( 1, &n );
  1821.     Opptr = Opsp;
  1822.     push( n );
  1823. }
  1824.  
  1825. getargs( n, ip )
  1826. int *ip;
  1827. {
  1828.     /*
  1829.      * Remove items from the Valstk and adjust stackptr.
  1830.      */
  1831.     int argc;
  1832.  
  1833.     if ( Commas > n )
  1834.     {
  1835.         /*
  1836.          * More arguments on stack than expected - remove excess
  1837.          */
  1838.         while ( Commas-- > n )
  1839.             pop();
  1840.     }
  1841.     else if ( Commas < n )
  1842.     {
  1843.         /*
  1844.          * Less arguments than expected - reduce n
  1845.          */
  1846.         n = Commas;
  1847.     }
  1848.  
  1849.     argc = 0;
  1850.     while ( n-- )
  1851.     {
  1852.         ++argc;
  1853.         ip[ n ] = pop();
  1854.     }
  1855.     return argc;
  1856. }
  1857.  
  1858. /*************************************************************
  1859. *         PROGRAM BUFFER MANIPULATION ROUTINES               *
  1860. *************************************************************/
  1861. makline( lno, line )
  1862. char *line;
  1863. {
  1864.     /*
  1865.      * Copy the string at "line" into the program buffer at "lno".
  1866.      * A block of memory will be allocated for the new string.
  1867.      */
  1868.     char *cp;
  1869.  
  1870.     if ( cp = Prog[ lno ] = malloc(strlen(line) + 1) )
  1871.     {
  1872.         strcpy( cp, line );
  1873.         return 1;
  1874.     }
  1875.     return 0;
  1876. }
  1877.  
  1878. addline( line )
  1879. char *line;
  1880. {
  1881.     /*
  1882.      * Add the string at "line" to the end of the program buffer.
  1883.      */
  1884.     if ( Progtop >= MAXLINES )
  1885.         return 0;
  1886.  
  1887.     if ( makline( Progtop, line ) )
  1888.     {
  1889.         ++Progtop;
  1890.         return 1;
  1891.     }
  1892.     return 0;
  1893. }
  1894.  
  1895. insline( lno, line )
  1896. char *line;
  1897. {
  1898.     /*
  1899.      * Insert the string, "line" before "lno" in the program buffer.
  1900.      */
  1901.     int i;
  1902.  
  1903.     if ( lno >= Progtop )
  1904.         return 0;
  1905.  
  1906.     if ( Progtop )
  1907.     {
  1908.         /*
  1909.          * There is at least one line in the buffer. First append
  1910.          * a new line to the end of the program buffer and duplicate
  1911.          * the last line.
  1912.          */
  1913.         i = Progtop;
  1914.         if ( i < MAXLINES )
  1915.         {
  1916.             ++Progtop;
  1917.             /*
  1918.              * Move all lines below "lno" down
  1919.              */
  1920.             while ( i-- > lno )
  1921.                 Prog[ i+1 ] = Prog[ i ];
  1922.             /*
  1923.              * Free up the string at "lno" and create a new
  1924.              * line there.
  1925.              */
  1926.             return makline( lno, line );
  1927.         }
  1928.         else
  1929.             return 0;
  1930.     }
  1931.     else
  1932.         /*
  1933.          * Nothing in program buffer yet - append the new line.
  1934.          */
  1935.         return addline( line );
  1936.  
  1937.     return 1;
  1938. }
  1939.  
  1940. delline( lno )
  1941. {
  1942.     char *cp;
  1943.     int i;
  1944.  
  1945.     if ( lno >= Progtop )
  1946.         return 0;
  1947.  
  1948.     /*
  1949.      * There is at least one line in the buffer. First delete
  1950.      * the line at "lno" in the program buffer.
  1951.      */
  1952.     free( Prog[ lno ] );
  1953.     /*
  1954.      * Then move all lines below "lno" up.
  1955.      */
  1956.     while ( ++lno < Progtop )
  1957.         Prog[ lno-1 ] = Prog[ lno ];
  1958.     --Progtop;
  1959.     return 1;
  1960. }
  1961.  
  1962. fmtline( n )
  1963. {
  1964.     fmtlno( n );
  1965.     puts( Prog[ n ] );
  1966.     newline();
  1967. }
  1968.  
  1969. fmtlno( n )
  1970. {
  1971.     printf( "\r%4d:", n+1 );
  1972. }
  1973.  
  1974. /*************************************************************
  1975. *                       MISCELLANEOUS                        *
  1976. **************************************************************/
  1977. initialize()
  1978. {
  1979.     /*
  1980.      * Initialization routine - for compilers that do not support
  1981.      * global variable initialization.
  1982.      */
  1983.  
  1984.     /*
  1985.      * initialize function table
  1986.      */
  1987.     Functab[0].f_name = "printf";
  1988.     Functab[0].f_addr = f_printf;
  1989.  
  1990.     Functab[1].f_name = "base";
  1991.     Functab[1].f_addr = f_base;
  1992.  
  1993.     Functab[2].f_name = "run";
  1994.     Functab[2].f_addr = f_run;
  1995.  
  1996.     Functab[3].f_name = "nl";
  1997.     Functab[3].f_addr = f_nl;
  1998.  
  1999.     Functab[4].f_name = "putn";
  2000.     Functab[4].f_addr = f_putn;
  2001.  
  2002.     Functab[5].f_name = "getn";
  2003.     Functab[5].f_addr = f_getn;
  2004.  
  2005.     Functab[6].f_name = "debug";
  2006.     Functab[6].f_addr = f_debug;
  2007.  
  2008.     Functab[7].f_name = "new";
  2009.     Functab[7].f_addr = f_new;
  2010.  
  2011.     Functab[8].f_name = "edit";
  2012.     Functab[8].f_addr = f_edit;
  2013.  
  2014.     Functab[9].f_name = "list";
  2015.     Functab[9].f_addr = f_list;
  2016.  
  2017.     Functab[10].f_name = "save";
  2018.     Functab[10].f_addr = f_save;
  2019.  
  2020.     Functab[11].f_name = "load";
  2021.     Functab[11].f_addr = f_load;
  2022.  
  2023.     Functab[12].f_name = "exit";
  2024.     Functab[12].f_addr = exit;
  2025.  
  2026.     Functab[13].f_name = "stop";
  2027.     Functab[13].f_addr = f_stop;
  2028.     /*
  2029.      * keyword lookup table
  2030.      */
  2031.     Keytab[0].k_name = "if";
  2032.     Keytab[0].k_value = T_IF;
  2033.  
  2034.     Keytab[1].k_name = "else";
  2035.     Keytab[1].k_value = T_ELSE;
  2036.  
  2037.     Keytab[2].k_name = "while";
  2038.     Keytab[2].k_value = T_WHILE;
  2039.  
  2040.     Keytab[3].k_name = "break";
  2041.     Keytab[3].k_value = T_BREAK;
  2042.     /*
  2043.      * string table
  2044.      */
  2045.     Strings = malloc( MAXSTRINGS );        
  2046.     /*
  2047.      * display number radix
  2048.      */
  2049.     push( 10 );
  2050.     f_base();
  2051.     pop();
  2052. }
  2053.  
  2054. reset()
  2055. {
  2056.     /*
  2057.      * Initialize parser variables
  2058.      */
  2059.     Opptr=Opsp=Valsp=Ifsp=Whsp=Level=Parens=Commas=Error=Progptr = 0;
  2060.     Eol = 1;
  2061. }
  2062.  
  2063. putresult( result )
  2064. {
  2065.     /*
  2066.      * Print results of an expression in current output format
  2067.      */
  2068.     printf( Ofmt, result );
  2069.     newline();
  2070. }
  2071.  
  2072. prompt()
  2073. {
  2074.     int i;
  2075.  
  2076.     for ( i=0; i<Level; ++i )
  2077.         putchar( '\t' );
  2078.     puts( "> " );
  2079. }
  2080.  
  2081. err( s )
  2082. {
  2083.     /*
  2084.      * Display an error message
  2085.      */
  2086.     if ( ! Error )
  2087.     {
  2088.         /*
  2089.          * We're only interested in the first one encountered
  2090.          * on a line, since error recovery is non-existent.
  2091.          */
  2092.         if ( Source )
  2093.             fmtlno( Progptr );
  2094.         puts( s );
  2095.         newline();
  2096.         Error = 1;
  2097.     }
  2098. }
  2099.  
  2100. newline()
  2101. {
  2102.     putchar( '\n' );
  2103.  
  2104. }
  2105.  
  2106. ishexdigit( c )
  2107. char c;
  2108. {
  2109.     return instr( c, "0123456789abcdefABCDEF" );
  2110. }
  2111.  
  2112. isoctdigit( c )
  2113. char c;
  2114. {
  2115.     return instr( c, "01234567" );
  2116. }
  2117.  
  2118. instr( c, s )
  2119. char c, *s;
  2120. {
  2121.     /*
  2122.      * Return TRUE if the character "c" is in the string "s"
  2123.      */
  2124.     while ( *s )
  2125.         if ( c == *s++ )
  2126.             return 1;
  2127.     return 0;
  2128. }
  2129.  
  2130. getkey()
  2131. {
  2132.     /*
  2133.      * Get a key directly from keyboard
  2134.      */
  2135.     return bios( 3, 0 );
  2136. }
  2137.  
  2138. gets( s )
  2139. char *s;
  2140. {
  2141.     int i, c;
  2142.  
  2143.     i = 0;
  2144.     while ( i<79 )
  2145.     {
  2146.         switch ( c = getkey() )
  2147.         {
  2148.         case '\r':
  2149.         case '\n':
  2150.             newline();
  2151.             goto done;
  2152.         case '\t':
  2153.             for ( c=0; c<3 && i<79; ++c )
  2154.                 putchar( s[ i++ ] = ' ' );
  2155.             break;
  2156.         case '\b':
  2157.             if ( i )
  2158.             {
  2159.                 --i;
  2160.                 puts( "\b \b" );
  2161.             }
  2162.             break;
  2163.         case 3:
  2164.             exit();
  2165.         case 4:
  2166.             Debug = !Debug;
  2167.             break;
  2168.         default:
  2169.             if ( ' '<=c && c<='~' )
  2170.                 putchar( s[ i++ ] = c );
  2171.         }
  2172.     }
  2173. done:
  2174.     s[ i ] = 0;
  2175.     return i;
  2176. }
  2177.